unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, Grids, DBGrids, DB, DBClient,
  XMLIntf,XMLDoc,AYConst;

type
  TFormMain = class(TForm)
    PageControl1: TPageControl;
    Panel1: TPanel;
    Button1: TButton;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    MemoXML: TMemo;
    DataSource1: TDataSource;
    ClientDataSet1: TClientDataSet;
    DBGrid1: TDBGrid;
    Button2: TButton;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
    function GetOutData(const AXML:string;var AOutData :OleVariant):Boolean;
    function GetEmptyData(AFieldList :TStrings;var AOutData :OleVariant):Boolean;

    function CheckAction(AXML :String;var AMsg : String):Boolean;
  public
    { Public declarations }
  end;

var
  FormMain: TFormMain;

implementation

{$R *.dfm}

procedure TFormMain.Button1Click(Sender: TObject);
var
  sXML : string;
  OutData : OleVariant;
  FieldList :TStrings;
  i : Integer;
begin
    FieldList :=TStringList.Create;
    try
      FieldList.Add('ID=20');
      FieldList.Add('NAME=80');
      FieldList.Add('pinyinCode=80');
      FieldList.Add('wubiCode=80');

    {  sXML := '';
      for i := 0 to MemoXML.Lines.Count -1 do
      begin
        sXML := sXML + Trim(MemoXML.Lines.Strings[i]);
      end;
     }
      sXML := MemoXML.Text;
      GetEmptyData(FieldList,OutData);
      if GetOutData(sXML,OutData) then
      begin
        ClientDataSet1.Data := OutData;

      end;
    finally
      FieldList.Free;
    end;
end;

function TFormMain.GetEmptyData(AFieldList: TStrings;
  var AOutData: OleVariant): Boolean;
var
  DataSet : TClientDataSet;
  i : Integer;
begin
  DataSet := TClientDataSet.Create(nil);
  try
    with DataSet do
    begin
      FieldDefs.Clear;
      FieldDefs.Add('_XH',ftInteger);
      for i := 0 to AFieldList.Count -1 do
        FieldDefs.Add(AFieldList.Names[i],ftString,StrToIntDef(AFieldList.ValueFromIndex[i],20));

      CreateDataSet;
      LogChanges := False;
      AOutData := Data;
    end;

  finally
    DataSet.Free;
  end;

end;

function TFormMain.GetOutData(const AXML: string;
  var AOutData: OleVariant): Boolean;
var
  i,j:Integer;
  XMLTran:TXMLTransition;
  ReXmlDoc:TXMLDocument;
  RootNode,Node1,Node2:IXMLNode;
  sName,sText:string;
  DataSet : TClientDataSet;
begin
  Result := False;
  if AXML <> '' then
  begin
    DataSet := TClientDataSet.Create(nil);
    XMLTran := TXMLTransition.Create;
    try
      DataSet.Data := AOutData;

      XMLTran.XMLDoc.Active := False;
      XMLTran.XMLDoc.XML.Clear;
      XMLTran.XMLDoc.XML.Text := UTF8Encode(AXML);
      XMLTran.XMLDoc.Active := True;

      if XMLTran.XMLDoc.Active then
      begin
        RootNode := XMLTran.XMLDoc.DocumentElement;
        Node1 := RootNode.ChildNodes.FindNode('list');

        with Node1.ChildNodes do
        begin
          for i := 0 to Count - 1 do
          begin
            with Nodes[i].ChildNodes do
            begin
              DataSet.Append;
              DataSet.FieldByName('_XH').AsInteger := i+1;
              for j := 0 to Count -1 do
              begin
                sName := Nodes[j].NodeName;
                sText := Nodes[j].Text;
                if DataSet.FindField(sName)<>nil then
                  DataSet.FieldByName(sName).AsString := sText;
              end;
              DataSet.Post;
            end;
          end;
        end;
      end;

      AOutData := DataSet.Data;
      Result :=True;
    finally
      XMLTran.Free;
      DataSet.Free;
    end;
  end;

end;

procedure TFormMain.Button2Click(Sender: TObject);
begin
  MemoXML.Lines.LoadFromFile('c:\ks.xml');
end;

function TFormMain.CheckAction(AXML: String; var AMsg: String): Boolean;
var
  iPos0,iPos1,iLen : Integer;
  sCode : string;
begin
  Result := False;
  AMsg := '';
  iPos0 := Pos('<message>',AXML);
  iPos1 := Pos('</message>',AXML);
  iLen := length('<message>');
  if (iPos0>0) and (iPos1>0) then
  begin
    AXML := Copy(AXML,iPos0+iLen,iPos1-iPos0 -iLen);
    iPos0 := Pos('<code>',AXML);
    iPos1 := Pos('</code>',AXML);
    iLen := length('<code>');
    sCode := Copy(AXML,iPos0+iLen,iPos1-iPos0 - iLen );
    Result := Trim(sCode)='800';
  //  if not Result then
    begin
      iPos0 := Pos('<detail>',AXML);
      iPos1 := Pos('</detail>',AXML);
      iLen := length('<detail>');
      AMsg := Trim(Copy(AXML,iPos0+iLen,iPos1-iPos0 - iLen));

    end;
  end;

end;

procedure TFormMain.Button3Click(Sender: TObject);
var
  sMsg : string;
begin
  CheckAction(MemoXML.Text,sMsg);
  ShowMessage(sMsg);
end;

end.
